unit uDimFormOut;

interface

procedure _GrayForms;
procedure _GrayDesktop;
procedure _NormalForms;

implementation

uses windows, classes, forms, Contnrs, Types, Graphics, sysutils;

const
  TRANSPARENT_LEVEL = 78;
  TRANSPARENT_STARTLEVEL = 00;
  TRANSPARENT_DELAY = 40*1000;

var
   gGrayForms : TComponentList;
   gTreadCnt: integer = 0;
   gTreadTerminateFlag: boolean = False;


procedure _GrayDesktop;
var
   loop : integer;
   wForm : TForm;

begin
   if not assigned(gGrayForms) then
   begin
      gGrayForms := TComponentList.Create;
      gGrayForms.OwnsObjects := true;

      for loop := 0 to Screen.MonitorCount - 1 do
      begin
         wForm := TForm.Create(nil);
         gGrayForms.Add(wForm);

         wForm.Position := poDesigned;
         wForm.AlphaBlend := true;
         wForm.AlphaBlendValue := TRANSPARENT_LEVEL;
         wForm.Color := clBlack;
         wForm.BorderStyle := bsNone;
         wForm.Enabled := false;
         wForm.BoundsRect := Screen.Monitors[loop].BoundsRect;
         SetWindowPos(wForm.handle, HWND_TOP, 0,0,0,0, SWP_NOSIZE or SWP_NOMOVE);
         wForm.Visible := true;
      end;
   end;
end;

procedure _GrayForms;
var
   loop, i : integer;
   wScrnFrm : TForm;
   wForm : TForm;
   wScreens : TList;
   r: TRect;
begin
   if not assigned(gGrayForms) then
   begin
      gGrayForms := TComponentList.Create;
      gGrayForms.OwnsObjects := true;

      wScreens := TList.create;
      try
         for loop := 0 to Screen.FormCount - 1 do
            wScreens.Add(Screen.Forms[loop]);

         for loop := 0 to wScreens.Count - 1 do
         begin
            wScrnFrm := wScreens[loop];

            if wScrnFrm.Visible then
            begin
               wForm := TForm.Create(wScrnFrm);
               gGrayForms.Add(wForm);

               //wForm.Position := poOwnerFormCenter;
               wForm.Position:= poDesigned;
               wForm.AlphaBlend := true;
               wForm.AlphaBlendValue := TRANSPARENT_STARTLEVEL;
               wForm.Color := clBlack;
               wForm.BorderStyle := bsNone;
               wForm.Enabled := false;

               i:= GetSystemMetrics(sm_cxFrame);
               r:= wScrnFrm.BoundsRect;
               r.Left:= r.Left+ i; r.Right:= r.Right - i; r.Bottom:= r.Bottom - i;
               r.Top:= r.Top + GetSystemMetrics(SM_CYCAPTION) + i - 1;

               wForm.Top:= wScrnFrm.Top;
               wForm.Left:= wScrnFrm.Left;

               wForm.BoundsRect := r;
               SetWindowLong(wForm.Handle, GWL_HWNDPARENT, wScrnFrm.Handle);
               SetWindowPos(wForm.handle, wScrnFrm.handle, 0,0,0,0, SWP_NOSIZE or SWP_NOMOVE);
               wForm.Visible := true;

               gTreadTerminateFlag:= False;
               TThread.CreateAnonymousThread(
                  procedure
                  var
                    i: integer;
                  begin
                    InterlockedIncrement(gTreadCnt);
                    try
                      while (not gTreadTerminateFlag) and wForm.Visible and
                      (wForm.AlphaBlendValue <  TRANSPARENT_LEVEL) do begin
                        if wForm.AlphaBlendValue = TRANSPARENT_STARTLEVEL then
                          for i:= 0 to (TRANSPARENT_DELAY div 60) do begin
                            if gTreadTerminateFlag then break;
                            TThread.Sleep(60);
                          end
                        else
                          TThread.Sleep(60);
                        if not gTreadTerminateFlag then
                          TThread.Synchronize( nil,
                            procedure begin
                              wForm.AlphaBlendValue:= wForm.AlphaBlendValue + 10;
                            end
                          );
                      end;
                    except
                    end;
                    InterlockedDecrement(gTreadCnt);
                  end
               ).Start();

            end;
         end;
      finally
        wScreens.free;
      end;
   end;
end;

procedure _NormalForms;
begin
  gTreadTerminateFlag:= True;
  while gTreadCnt > 0 do begin
    Sleep(0);
    Application.ProcessMessages;
  end;

  FreeAndNil(gGrayForms);
end;

initialization
   gGrayForms := nil;

end.
